home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Peter Lewis / PNL Libraries / MyAssocStrings.p < prev    next >
Encoding:
Text File  |  1994-10-11  |  2.5 KB  |  125 lines  |  [TEXT/PJMM]
  1. unit MyAssocStrings;
  2.  
  3. interface
  4.  
  5.     procedure AssocCreate (var h: handle);
  6.     procedure AssocDestroy (var h: handle);
  7.     function AssocCount (h: handle): longInt;
  8.     procedure AssocGetIndexedKey (h: handle; index: longInt; var key, data: str255);
  9.     procedure AssocGet (h: handle; key: str255; var data: str255);
  10.     procedure AssocSet (h: handle; key, data: str255);
  11.  
  12. implementation
  13.  
  14.     uses
  15.         QLowLevel;
  16.  
  17.     function GetByte (p: univ Ptr; offset: longint): integer;
  18.     inline
  19.         $201F, $D09F, $2040, $4240, $1010, $3E80;
  20.  
  21.     procedure AssocCreate (var h: handle);
  22.     begin
  23.         h := NewHandle(0);
  24.     end;
  25.  
  26.     procedure AssocDestroy (var h: handle);
  27.     begin
  28.         DisposeHandle(h);
  29.         h := nil;
  30.     end;
  31.  
  32.     procedure Next (h: handle; var pos: longInt);
  33.     begin
  34.         pos := pos + GetByte(h^, pos) + 1;
  35.     end;
  36.  
  37.     procedure CopyString (h: handle; pos: longInt; var s: str255);
  38.     begin
  39.         BlockMove(AddPtrLong(h^, pos), @s, GetByte(h^, pos) + 1);
  40.     end;
  41.  
  42.     function AssocCount (h: handle): longInt;
  43.         var
  44.             pos, size: longInt;
  45.             count: longInt;
  46.     begin
  47.         count := 0;
  48.         size := GetHandleSize(h);
  49.         pos := 0;
  50.         while pos < size do begin
  51.             Next(h, pos);
  52.             Next(h, pos);
  53.             count := count + 1;
  54.         end;
  55.         AssocCount := count;
  56.     end;
  57.  
  58.     procedure AssocGetIndexedKey (h: handle; index: longInt; var key, data: str255);
  59.         var
  60.             pos, size: longInt;
  61.     begin
  62.         size := GetHandleSize(h);
  63.         pos := 0;
  64.         while (pos < size) & (index > 1) do begin
  65.             Next(h, pos);
  66.             Next(h, pos);
  67.             index := index - 1;
  68.         end;
  69.         if (pos < size) & (index = 1) then begin
  70.             CopyString(h, pos, key);
  71.             Next(h, pos);
  72.             CopyString(h, pos, data);
  73.         end
  74.         else begin
  75.             key := '';
  76.             data := '';
  77.         end;
  78.     end;
  79.  
  80.     function GetPos (h: handle; var key: str255; var pos: longInt): boolean;
  81.         var
  82.             size: longInt;
  83.             thiskey: str255;
  84.     begin
  85.         GetPos := false;
  86.         size := GetHandleSize(h);
  87.         pos := 0;
  88.         while pos < size do begin
  89.             CopyString(h, pos, thiskey);
  90.             if IUEqualString(thiskey, key) = 0 then begin
  91.                 GetPos := true;
  92.                 leave;
  93.             end;
  94.             Next(h, pos);
  95.             Next(h, pos);
  96.         end;
  97.     end;
  98.  
  99.     procedure AssocGet (h: handle; key: str255; var data: str255);
  100.         var
  101.             pos: longInt;
  102.     begin
  103.         data := '';
  104.         if GetPos(h, key, pos) then begin
  105.             Next(h, pos);
  106.             CopyString(h, pos, data);
  107.         end;
  108.     end;
  109.  
  110.     procedure AssocSet (h: handle; key, data: str255);
  111.         var
  112.             err: OSErr;
  113.             pos: longInt;
  114.     begin
  115.         if GetPos(h, key, pos) then begin
  116.             Next(h, pos);
  117.             pos := Munger(h, pos, nil, GetByte(h^, pos) + 1, @data, length(data) + 1);
  118.         end
  119.         else begin
  120.             err := PtrAndHand(@key, h, length(key) + 1);
  121.             err := PtrAndHand(@data, h, length(data) + 1);
  122.         end;
  123.     end;
  124.  
  125. end.